home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Simple ico275161042001.psc / FRM2ICN4.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2001-09-27  |  8.1 KB  |  315 lines
  1. VERSION 4.00
  2. Begin VB.Form Form2 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Open File:"
  6.    ClientHeight    =   3180
  7.    ClientLeft      =   2016
  8.    ClientTop       =   2580
  9.    ClientWidth     =   7260
  10.    ControlBox      =   0   'False
  11.    BeginProperty Font 
  12.       name            =   "MS Sans Serif"
  13.       charset         =   0
  14.       weight          =   700
  15.       size            =   7.8
  16.       underline       =   0   'False
  17.       italic          =   0   'False
  18.       strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H80000008&
  21.    Height          =   3504
  22.    Icon            =   "FRM2ICN4.frx":0000
  23.    Left            =   1968
  24.    LinkTopic       =   "Form2"
  25.    MaxButton       =   0   'False
  26.    MinButton       =   0   'False
  27.    ScaleHeight     =   3180
  28.    ScaleWidth      =   7260
  29.    Top             =   2304
  30.    Width           =   7356
  31.    Begin VB.DriveListBox Drive1 
  32.       Appearance      =   0  'Flat
  33.       Height          =   288
  34.       Left            =   3000
  35.       TabIndex        =   5
  36.       Top             =   2760
  37.       Width           =   2412
  38.    End
  39.    Begin VB.CommandButton CmdCancel 
  40.       Appearance      =   0  'Flat
  41.       BackColor       =   &H80000005&
  42.       Caption         =   "Cancel"
  43.       Height          =   372
  44.       Left            =   5640
  45.       TabIndex        =   1
  46.       Top             =   720
  47.       Width           =   1452
  48.    End
  49.    Begin VB.CommandButton CmdOK 
  50.       Appearance      =   0  'Flat
  51.       BackColor       =   &H80000005&
  52.       Caption         =   "OK"
  53.       Height          =   372
  54.       Left            =   5640
  55.       TabIndex        =   0
  56.       Top             =   120
  57.       Width           =   1452
  58.    End
  59.    Begin VB.FileListBox File1 
  60.       Appearance      =   0  'Flat
  61.       Height          =   1944
  62.       Left            =   240
  63.       TabIndex        =   3
  64.       Top             =   720
  65.       Width           =   2412
  66.    End
  67.    Begin VB.DirListBox Dir1 
  68.       Appearance      =   0  'Flat
  69.       Height          =   2055
  70.       Left            =   3000
  71.       TabIndex        =   4
  72.       Top             =   360
  73.       Width           =   2415
  74.    End
  75.    Begin VB.TextBox Text1 
  76.       Appearance      =   0  'Flat
  77.       Height          =   288
  78.       Left            =   240
  79.       TabIndex        =   2
  80.       TabStop         =   0   'False
  81.       Top             =   360
  82.       Width           =   2412
  83.    End
  84.    Begin VB.Label LabelDrives 
  85.       Appearance      =   0  'Flat
  86.       BackColor       =   &H00C0C0C0&
  87.       Caption         =   "Drives:"
  88.       ForeColor       =   &H80000008&
  89.       Height          =   192
  90.       Left            =   3000
  91.       TabIndex        =   8
  92.       Top             =   2520
  93.       Width           =   1212
  94.    End
  95.    Begin VB.Label LabelDirectory 
  96.       Appearance      =   0  'Flat
  97.       BackColor       =   &H00C0C0C0&
  98.       Caption         =   "&Directories:"
  99.       ForeColor       =   &H80000008&
  100.       Height          =   192
  101.       Left            =   3000
  102.       TabIndex        =   7
  103.       Top             =   120
  104.       Width           =   1212
  105.    End
  106.    Begin VB.Label LabelFileName 
  107.       Appearance      =   0  'Flat
  108.       BackColor       =   &H00C0C0C0&
  109.       Caption         =   "File &Name:"
  110.       ForeColor       =   &H80000008&
  111.       Height          =   252
  112.       Left            =   240
  113.       TabIndex        =   6
  114.       Top             =   120
  115.       Width           =   1572
  116.    End
  117. Attribute VB_Name = "Form2"
  118. Attribute VB_Creatable = False
  119. Attribute VB_Exposed = False
  120. Rem  List, ListCount, and ListIndex
  121. Private Sub CmdCancel_Click()
  122. Unload Form2
  123. Form1.Enabled = True
  124. Form1.SetFocus
  125. End Sub
  126. Private Sub CmdOK_Click()
  127. On Error GoTo ErrHandler
  128. If RTrim$(LTrim$(Text1.Text)) = "\" Then
  129.   Dir1.Path = Left$(Drive1.Drive, 2) + "\"
  130.   Exit Sub
  131. End If
  132. AsteriskFlag% = 0
  133. For a% = 1 To Len(Text1.Text)
  134. If Mid$(Text1.Text, a%, 1) = "*" Then AsteriskFlag% = 1
  135. Next a%
  136. If AsteriskFlag% = 1 Then
  137.   Rem Is it a pattern?
  138.   File1.Pattern = Text1.Text
  139.   GoTo FocusThenExit
  140. End If
  141. Rem if no asterisk in Text1.Text1 then...
  142. Rem Is it a file name?
  143. LoadName = File1.Path
  144. If Right$(LoadName, 1) <> "\" Then LoadName = LoadName + "\"
  145. LoadName = LoadName + Text1.Text
  146. Rem If DotFlag = 0 Then LoadName = LoadName + ".ico"
  147. E% = 0
  148. If Len(Dir$(LoadName, 6)) > 0 Then GoTo Done
  149. 'Is it a directory?
  150. t$ = Text1.Text
  151. If Right$(t$, 1) = "\" Then t$ = Left$(t$, Len(t$) - 1)
  152. If Left$(t$, 1) = "\" Then
  153.   t$ = Left$(Drive1.Drive, 2) + t$
  154.   GoTo TestDir
  155. End If
  156. Rem t$ = Text1.Text
  157. If Right$(Dir1.Path, 1) <> "\" Then t$ = "\" + t$
  158. t$ = Dir1.Path + t$
  159. E% = 0
  160. TestDir:
  161. E% = 0
  162. Dir1.Path = t$
  163. If E% = 0 Then GoTo FocusThenExit
  164. a% = MsgBox("Invalid File/Directory", 48, "Error")
  165. GoTo FocusThenExit
  166. Done:
  167. TempDrive = Drive1.Drive
  168. TempPath = Dir1.Path
  169. TempIndex = File1.ListIndex
  170. Call GotFileName
  171. Unload Form2
  172. Form1.Enabled = True
  173. Form1.SetFocus
  174. Call LoadIconFile
  175. Exit Sub
  176. ErrHandler:
  177. E% = Err
  178. Resume Next
  179. FocusThenExit:
  180. Text1.SetFocus
  181. Text1.SelStart = 0
  182. Text1.SelLength = Len(Text1.Text)
  183. End Sub
  184. Private Sub Dir1_Change()
  185. File1.Path = Dir1.Path
  186. Rem Text1.Text = File1.FileName
  187. Rem  List, ListCount, and ListIndex
  188. If File1.ListCount > 0 Then
  189.   Text1.Text = File1.List(0)
  190. End If
  191. Text1.SetFocus
  192. Text1.SelStart = 0
  193. Text1.SelLength = Len(Text1.Text)
  194. End Sub
  195. Private Sub Drive1_Change()
  196. On Error GoTo ErrHandler
  197. Dir1.Path = Drive1.Drive
  198. Exit Sub
  199. ErrHandler:
  200. Resume Next
  201. End Sub
  202. Private Sub File1_Click()
  203. Text1.Text = File1.filename
  204. Text1.SetFocus
  205. Text1.SelStart = 0
  206. Text1.SelLength = Len(Text1.Text)
  207. End Sub
  208. Private Sub File1_DblClick()
  209. LoadName = File1.Path
  210. If Right$(LoadName, 1) <> "\" Then LoadName = LoadName + "\"
  211. LoadName = LoadName + File1.List(File1.ListIndex)
  212. TempDrive = Drive1.Drive
  213. TempPath = Dir1.Path
  214. TempIndex = File1.ListIndex
  215. Rem Form2.Enabled = False
  216. Rem Form2.Visible = False
  217. Call GotFileName
  218. Unload Form2
  219. Form1.Enabled = True
  220. Form1.SetFocus
  221. End Sub
  222. Private Sub File1_KeyPress(KeyAscii As Integer)
  223. If KeyAscii = 13 Then
  224.   Rem Form2.Enabled = False
  225.   Rem Form2.Visible = False
  226.   Call CmdOK_Click
  227. End If
  228. End Sub
  229. Private Sub File1_PathChange()
  230. Text1.Text = File1.filename
  231. End Sub
  232. Private Sub File1_PatternChange()
  233. Rem  List, ListCount, and ListIndex
  234. If File1.ListCount > 0 Then Text1.Text = File1.List(0)
  235. End Sub
  236. Private Sub Form_Load()
  237. FileFoundFlag = 0
  238. Form1.Enabled = False
  239. File1.Pattern = "*.ico"
  240. Width = 7356
  241. Height = 3504
  242. Left = (Screen.Width - Width) / 2
  243. Top = (Screen.Height - Height) / 2
  244. LabelFileName.Left = 240
  245. LabelFileName.Top = 120
  246. LabelFileName.Width = 1572
  247. LabelFileName.Height = 252
  248. LabelDirectory.Left = 3000
  249. LabelDirectory.Top = 120
  250. LabelDirectory.Width = 1212
  251. LabelDirectory.Height = 192
  252. LabelDrives.Left = 3000
  253. LabelDrives.Top = 2520
  254. LabelDrives.Width = 1212
  255. LabelDrives.Height = 192
  256. Text1.Left = 240
  257. Text1.Top = 360
  258. Text1.Width = 2412
  259. Text1.Height = 288
  260. File1.Left = 240
  261. File1.Top = 720
  262. File1.Width = 2412
  263. File1.Height = 1944
  264. Dir1.Left = 3000
  265. Dir1.Top = 360
  266. Dir1.Width = 2415
  267. Dir1.Height = 2055
  268. Drive1.Left = 3000
  269. Drive1.Top = 2760
  270. Drive1.Width = 2412
  271. Rem Drive1.Height = 288 (Read only!)
  272. CmdOK.Left = 5640
  273. CmdOK.Top = 120
  274. CmdOK.Width = 1452
  275. CmdOK.Height = 372
  276. CmdCancel.Left = 5640
  277. CmdCancel.Top = 720
  278. CmdCancel.Width = 1452
  279. CmdCancel.Height = 372
  280. Visible = True
  281. If TempDrive = "" Then
  282.   Open "c:\iconpath.cfg" For Binary As #1
  283.   Close
  284.   Open "c:\IconPath.cfg" For Input As #1
  285.   l& = LOF(1)
  286.   If l& > 0 Then Line Input #1, p$
  287.   Close
  288.   If l& > 0 Then
  289.     TempDrive = Left$(p$, 2)
  290.     TempPath = Mid$(p$, 3)
  291.   End If
  292. End If
  293. Rem File1.ListIndex = 0
  294. If TempDrive > "" Then
  295.   Drive1.Drive = TempDrive
  296.   Dir1.Path = TempPath
  297.   Rem If File1.ListCount > 0 Then File1.ListIndex = TempIndex
  298. End If
  299. Text1.SetFocus
  300. Text1.SelStart = 0
  301. Text1.SelLength = Len(Text1.Text)
  302. End Sub
  303. Private Sub GotFileName()
  304. Tmp$ = TempPath + Chr$(13) + Chr$(10)
  305. Open "c:\IconPath.cfg" For Binary As #1
  306. Put #1, 1, Tmp$
  307. Close
  308. FileFoundFlag = 1
  309. End Sub
  310. Private Sub Text1_KeyPress(KeyAscii As Integer)
  311. If KeyAscii = 13 Then
  312.   Call CmdOK_Click
  313. End If
  314. End Sub
  315.